perm filename PICBUF.SAI[PIC,HE]2 blob
sn#423183 filedate 1979-03-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY PAGFLT,GETBUF,FNDBUF,FREBUF,USEBUF,INDMP,UINDMP,OUTDMP,NHOUTDMP,GETPNT,PUTPNT,INPTR,OUTPTR,ROWS,COLMS,
C00029 ENDMK
C⊗;
ENTRY PAGFLT,GETBUF,FNDBUF,FREBUF,USEBUF,INDMP,UINDMP,OUTDMP,NHOUTDMP,GETPNT,PUTPNT,INPTR,OUTPTR,ROWS,COLMS,
BYTSZ,PAKCOL,BUFSZ,BUFST,THRHLD,SUPFAC,ISUBST,JSUBST,DMEAN,DSTDEV,BUFINIT,FORINIT;
BEGIN "PICBUF"
COMMENT THIS FILE IS A SAIL SIMULATION OF THE FAIL PICBUF ROUTINES
AT CMU;
SAFE INTERNAL INTEGER ARRAY ROWTAB,PICTAB,COLTAB,USETAB,HEDTAB,DIRTY,PAGFLT[0:16];
OWN INTEGER NUMPAG,NEWSSW,INITBUF;
DEFINE ROWLOC=11,
COLLOC=2,
BYTLOC=1,
SUPLOC=7,
THRLOC=6,
MENLOC=8,
DEVLOC=9,
SIZLOC=4,
RSIZLOC=3,
SUBSTLOC=5,
RTABLOC=12,
TFILELOC=13,
CHANLOC=14,
MAXUSE=30;
REQUIRE "BAYSAI.SAI" SOURCE!FILE;
comment SOURCE!V(CORSER);
comment lib!v(corser);
REQUIRE "CORSER" SOURCE!FILE;
require "corser" library; require " LI"&"B!V(corser) " message;
require "tenexio.sai" source!file;
DEFINE PAGED(BUF)="(USETAB[BUF]>0)";
FORWARD SIMPLE INTERNAL PROCEDURE BUFINIT;
DEFINE IINNIITT="BEGIN BUFINIT; PRINT(""You failed to initialize the buffers.
It was just done for you."",crlf) END;";
SIMPLE INTERNAL INTEGER PROCEDURE FNDBUF(INTEGER INDICATOR);
BEGIN
INTEGER I;
IF INITBUF=0 THEN IINNIITT;
FOR I←0 STEP 1 UNTIL 16 DO
IF USETAB[I]=0
THEN BEGIN
USETAB[I]←IF INDICATOR=0 THEN -2 ELSE IF INDICATOR>0 THEN NUMPAG ELSE INDICATOR;
RETURN(I);
END;
RETURN(-1);
END;
DEFINE ITRSIZ(BUFFER)="(MEMORY[HEDTAB[BUFFER]+RSIZLOC])";
DEFINE ITFSIZ(BUFFER)="(MEMORY[HEDTAB[BUFFER]+SIZLOC])";
DEFINE ITRT(BUFFER)="MEMORY[HEDTAB[BUFFER]+RTABLOC]";
DEFINE TFILE(BUFFER)="MEMORY[HEDTAB[BUFFER]+TFILELOC]";
DEFINE IOCHAN(BUFFER)="MEMORY[HEDTAB[BUFFER]+CHANLOC]";
DEFINE ITROWS(BUFFER)="(MEMORY[HEDTAB[BUFFER]+ROWLOC])";
DEFINE USC(BUFFER)="MEMORY[HEDTAB[BUFFER]]";
SIMPLE INTERNAL INTEGER PROCEDURE ROWS(INTEGER BUFFER);
RETURN(ITROWS(BUFFER));
DEFINE ITCOLMS(BUFFER)="(MEMORY[HEDTAB[BUFFER]+COLLOC])";
SIMPLE INTERNAL INTEGER PROCEDURE COLMS(INTEGER BUFFER);
RETURN(ITCOLMS(BUFFER));
SIMPLE INTERNAL INTEGER PROCEDURE BYTSZ(INTEGER BUFFER);
RETURN(MEMORY[HEDTAB[BUFFER]+BYTLOC]);
SIMPLE INTERNAL INTEGER PROCEDURE ISUBST(INTEGER BUFFER);
RETURN((MEMORY[HEDTAB[BUFFER]+SUBSTLOC]) LSH -18);
SIMPLE INTERNAL INTEGER PROCEDURE JSUBST(INTEGER BUFFER);
RETURN((MEMORY[HEDTAB[BUFFER]+SUBSTLOC]) LAND '777777);
SIMPLE INTERNAL INTEGER PROCEDURE SUPFAC(INTEGER BUFFER);
RETURN(MEMORY[HEDTAB[BUFFER]+SUPLOC]);
SIMPLE INTERNAL INTEGER PROCEDURE BUFSZ(INTEGER BUFFER);
RETURN(ITFSIZ(BUFFER));
SIMPLE INTERNAL INTEGER PROCEDURE DSTDEV(INTEGER BUFFER);
RETURN(MEMORY[HEDTAB[BUFFER]+DEVLOC]);
SIMPLE INTERNAL INTEGER PROCEDURE DMEAN(INTEGER BUFFER);
RETURN(MEMORY[HEDTAB[BUFFER]+MENLOC]);
SIMPLE INTERNAL INTEGER PROCEDURE THRHLD(INTEGER BUFFER);
RETURN(MEMORY[HEDTAB[BUFFER]+THRLOC]);
SIMPLE INTERNAL PROCEDURE PUTSUP(INTEGER SUPLEV,BUFFER);
MEMORY[HEDTAB[BUFFER]+SUPLOC]←SUPLEV;
SIMPLE INTERNAL PROCEDURE PUTSUB(INTEGER STI,STJ,BUFFER);
MEMORY[HEDTAB[BUFFER]+SUBSTLOC]←(STI LSH 18) LOR STJ;
SIMPLE INTERNAL PROCEDURE PUTDEV(INTEGER DEVLEV,BUFFER);
MEMORY[HEDTAB[BUFFER]+DEVLOC]←DEVLEV;
SIMPLE INTERNAL PROCEDURE PUTTHR(INTEGER THRLEV,BUFFER);
MEMORY[HEDTAB[BUFFER]+THRLOC]←THRLEV;
SIMPLE INTERNAL PROCEDURE PUTMEN(INTEGER MENLEV,BUFFER);
MEMORY[HEDTAB[BUFFER]+MENLOC]←MENLEV;
SIMPLE INTERNAL INTEGER PROCEDURE USEBUF(INTEGER BUFFER);
IF 0≤BUFFER≤16 THEN RETURN(PICTAB[BUFFER]) ELSE RETURN(0);
DEFINE REF(A)="MEMORY[BUFLOC+A]";
INTERNAL INTEGER PROCEDURE HDRIN(INTEGER CHAN, BUF);
BEGIN
INTEGER BUFLOC,DUM,TYP,ISIZZ,JSIZZ,USCBYT;
SAFE INTEGER ARRAY ARR[0:'25];
BUFLOC←GETZCORE(128);
ARRYIN(CHAN,MEMORY[BUFLOC],128);
USCBYT←0;
COMMENT DUPLICATE CHECK FOR USC FILES REMOVED FROM HERE IT WAS THE ALL 0 CHECK
NO LONGER NECESSARY;
IF (REF(0)=-1) AND (0<REF(1) ≤ 36) AND (REF(3)≤REF(4) AND REF(5)≤REF(6)) THEN TYP←3 ! SUAI;
ELSE IF (REF(5)≤'777777) AND (0<REF(2)≤36) AND (0<REF(3)≤36) AND (REF(4)=REF(0)*((REF(1)-1)%(36%REF(2))+1)) THEN TYP←2 ! SRI;
ELSE IF (0<REF(1)≤36) AND REF(0)=128 AND REF(5)≥'777777 THEN TYP←0
else begin ! NO HEADER;
GTFDB(CHAN,ARR);
USCBYT←(ARR['11] LSH -24) LAND '77;
JSIZZ←IF USCBYT=8 THEN ARR['12] ELSE ARR['12]*4;
ISIZZ←SQRT(JSIZZ);
IF JSIZZ=(ISIZZ*ISIZZ) THEN BEGIN JSIZZ←ISIZZ; USCBYT←8; TYP←1 END
ELSE BEGIN PRINT("This is not a good file, will assume a file without header.
But it is not a square image. Give the dimensions please (a 0
indicates you do not wish this file).
I size: ");
isizz←CVD(INTTY);
IF ISIZZ≥0 THEN BEGIN PRINT("J size: "); JSIZZ←CVD(INTTY); PRINT("Bytesize: "); USCBYT←CVD(INTTY) END
ELSE BEGIN PRINT("This was an illegal image.",crlf); RETURN(0) END;
TYP←1; END
end;
CASE TYP OF BEGIN
; COMMENT STD CMU;
BEGIN COMMENT NO HEADER USC SQUARE FILES;
REF(0)←0;
REF(1)←IF USCBYT=0 THEN 8 ELSE USCBYT;
REF(2)←JSIZZ;
REF(3)←((JSIZZ-1)%(36%(IF USCBYT=0 THEN 8 ELSE USCBYT)))+1;
REF(4)←REF(3)*ISIZZ;
REF(5)←'1000001;
FOR DUM←6 STEP 1 UNTIL 10 DO REF(DUM)←0;
REF(ROWLOC)←ISIZZ;
FOR DUM←30 STEP 1 UNTIL 127 DO REF(DUM)←0;
END;
BEGIN REF(1) SWAP REF(2); COMMENT SRI FILES;
REF(3)←REF(4)%REF(0);
REF(5)←'1000001;
REF(0)←128 END;
BEGIN REF(0)←(REF(7)) LAND '777777; COMMENT SAIL IMAGE FILES;
REF(4)←REF(2)*(REF(4)-REF(3)+1);
DUM←REF(6)-REF(5)+1;
REF(6)←REF(7)←0;
REF(5)←(REF(3) LSH 18) LOR REF(5);
REF(3)←REF(2);
REF(2)←DUM END;
END;
MEMORY[BUFLOC+ROWLOC]←MEMORY[BUFLOC+SIZLOC]%MEMORY[BUFLOC+RSIZLOC];
SMEAR(BUFLOC+RTABLOC,MAXUSE-RTABLOC,0);
SWDPTR(CHAN,REF(0));
RETURN(BUFLOC);
END;
INTERNAL PROCEDURE INOUT(INTEGER IC,OC,NUM);
BEGIN
SAFE INTEGER ARRAY BUFR[0:127];
INTEGER I;
FOR I←128 STEP 128 UNTIL NUM DO
BEGIN
ARRYIN(IC,BUFR[0],128);
ARRYOUT(OC,BUFR[0],128);
END;
I←NUM-(I-128);
IF I>0 THEN BEGIN
ARRYIN(IC,BUFR[0],I);
ARRYOUT(OC,BUFR[0],I);
END;
END;
SIMPLE STRING PROCEDURE NEWNAM(INTEGER BUF);
RETURN("BUF"&CVS(BUF)&"-"&CVS(GJINF(0,0,0))&".TMP");
SIMPLE INTERNAL INTEGER PROCEDURE ALLOCPIC(INTEGER BUF);
BEGIN
INTEGER SIZEC,LOCC;
PAGFLT[BUF]←0;
SIZEC←MEMORY[HEDTAB[BUF]+SIZLOC];
IF PAGED(BUF) AND (SIZEC<1024) THEN USETAB[BUF]←-1;
IF USETAB[BUF]=-2
THEN USETAB[BUF]←IF ('377000<(2*SIZEC+HEDTAB[BUF])) OR SIZEC>35000 THEN NUMPAG ELSE -1;
IF PAGED(BUF) AND (SIZEC<1024) THEN USETAB[BUF]←-1;
IF PAGED(BUF) THEN SIZEC←USETAB[BUF]*(ITRSIZ(BUF)+1);
IF NEWSSW THEN PRINT("Allocated ",SIZEC," words of core.",IF PAGED(BUF) THEN "(paged)" else "(incore)",CRLF);
LOCC←IF PAGED(BUF) THEN GETZCORE(SIZEC) ELSE GETCORE(SIZEC);
MEMORY[HEDTAB[BUF]+RTABLOC]←LOCC+SIZEC-USETAB[BUF];
RETURN(LOCC)
END;
SIMPLE INTERNAL INTEGER PROCEDURE RCTABS(INTEGER BUF);
BEGIN
INTEGER INITPTR,I,J;
ROWTAB[BUF]←GETCORE(ROWS(BUF));
COLTAB[BUF]←GETCORE(COLMS(BUF));
INITPTR←POINT(BYTSZ(BUF),MEMORY[PICTAB[BUF]],-1);
INITPTR←INITPTR-PICTAB[BUF];
FOR I←1 STEP 1 UNTIL COLMS(BUF) DO
BEGIN
MEMORY[COLTAB[BUF]+I-1]←INITPTR;
IBP(INITPTR);
END;
IF PAGED(BUF)
THEN BEGIN
SMEAR(ROWTAB[BUF],ITROWS(BUF),0);
INITPTR←ITRT(BUF);
FOR I←0 THRU USETAB[BUF]-1 DO
MEMORY[INITPTR+I]←-(PICTAB[BUF]+I*ITRSIZ(BUF));
END
ELSE FOR J←1 STEP 1 UNTIL ROWS(BUF) DO
MEMORY[ROWTAB[BUF]+J-1]←PICTAB[BUF]+(J-1)*ITRSIZ(BUF);
END;
FORWARD SIMPLE INTERNAL PROCEDURE FREBUF(INTEGER BUF);
SIMPLE INTERNAL PROCEDURE INDMP(STRING DEV, FILE; INTEGER BUF; REFERENCE INTEGER FLAG);
BEGIN
INTEGER CHAN;
IF INITBUF=0 THEN IINNIITT;
WHILE TRUE DO BEGIN
CHAN←OPENFILE(FILE,"RCE");
IF CHAN ≠-1 THEN DONE;
IF FLAG=-2 THEN BEGIN IF ¬ USEBUF(BUF) THEN FREBUF(BUF);
FLAG←-1; RETURN END;
PRINT("FILE NOT FOUND: ",FILE," NEW NAME: ");
FILE←INTTY;
IF LENGTH(FILE)=0 THEN BEGIN IF NOT USEBUF(BUF) THEN FREBUF(BUF);
FLAG←-1; RETURN; END;
END;
IF (HEDTAB[BUF]←HDRIN(CHAN,BUF))=0 THEN BEGIN IF ¬ USEBUF(BUF) THEN FREBUF(BUF);
FLAG←-1; RETURN END;
PICTAB[BUF]←ALLOCPIC(BUF);
RCTABS(BUF);
IF PAGED(BUF) THEN
ELSE ARRYIN(CHAN,MEMORY[PICTAB[BUF]],ITFSIZ(BUF));
IF PAGED(BUF) THEN IOCHAN(BUF)←CHAN
ELSE CFILE(CHAN);
FLAG←0;
END;
SIMPLE INTERNAL PROCEDURE UINDMP(STRING DEV, FILE; INTEGER BUF; REFERENCE INTEGER FLAG; INTEGER SIZZ);
BEGIN
INTEGER CHAN,ISIZZ,JSIZZ;
IF INITBUF=0 THEN IINNIITT;
CHAN←OPENFILE(FILE,"RC");
JSIZZ←SIZZ LAND '777777;
ISIZZ←SIZZ LSH -18;
IF ISIZZ=0 THEN ISIZZ←JSIZZ;
HEDTAB[BUF]←GETZCORE(128);
MEMORY[HEDTAB[BUF]]←0;
MEMORY[HEDTAB[BUF]+1]←8;
MEMORY[HEDTAB[BUF]+2]←JSIZZ;
MEMORY[HEDTAB[BUF]+3]←((JSIZZ-1)%(36%8))+1;
MEMORY[HEDTAB[BUF]+4]←MEMORY[HEDTAB[BUF]+3]*ISIZZ;
MEMORY[HEDTAB[BUF]+5]←(1 LSH 18) LOR 1;
FOR DUM←6 STEP 1 UNTIL 10 DO MEMORY[HEDTAB[BUF]+DUM]←0;
MEMORY[HEDTAB[BUF]+ROWLOC]←SIZZ;
PICTAB[BUF]←ALLOCPIC(BUF);
RCTABS(BUF);
IF PAGED(BUF) THEN
ELSE ARRYIN(CHAN,MEMORY[PICTAB[BUF]],ITFSIZ(BUF));
IF PAGED(BUF) THEN IOCHAN(BUF)←CHAN
ELSE CFILE(CHAN);
FLAG←0;
END;
DEFINE ROWP(I)="MEMORY[ROWTAB[BUF]+I-1]",
COLP(J)="MEMORY[COLTAB[BUF]+J-1]";
SIMPLE INTERNAL PROCEDURE ROWOUT(INTEGER I,BUF);
BEGIN
INTEGER WPR,IC;
SWDPTR(IC←IOCHAN(BUF),USC(BUF)+(WPR←ITRSIZ(BUF))*(I-1));
ARRYOUT(IC,MEMORY[ROWP(I)],WPR);
END;
DEFINE RR(A)="MEMORY[HEDTAB[BUF]+A]";
INTERNAL PROCEDURE NHOUTDMP(STRING DEV, FILE; INTEGER BUF; REFERENCE INTEGER FLAG);
BEGIN
INTEGER CHAN,TCHAN,I;
SAFE INTEGER ARRAY ARR[0:'25];
FLAG←0;
CHAN←OPENFILE(FILE,"WC");
IF PAGED(BUF) THEN BEGIN TCHAN←IOCHAN(BUF);
IF DIRTY[BUF] THEN FOR I←1 THRU USETAB[BUF] DO
IF (DUM←MEMORY[ITRT(BUF)+I-1])≠0 THEN ROWOUT(DUM,BUF);
SWDPTR(TCHAN,USC(BUF));
INOUT(TCHAN,CHAN,ITFSIZ(BUF));
DIRTY[BUF]←0;
END
ELSE ARRYOUT(CHAN,MEMORY[PICTAB[BUF]],ITFSIZ(BUF));
CLOSF(CHAN);
GTFDB(CHAN,ARR);
IF ((ARR['11] LSH -24) LAND '77)=36
THEN BEGIN
CHFDB(CHAN,'11,'007700000000,'001000000000);
CHFDB(CHAN,'12,-1,ARR['12]*4);
END;
CFILE(CHAN);
END;
INTERNAL PROCEDURE OUTDMP(STRING DEV, FILE; INTEGER BUF; REFERENCE INTEGER FLAG);
BEGIN
INTEGER CHAN,DUM,I,OUSCBUF;
SAFE INTEGER ARRAY TARR[0:127];
IF FLAG=1 THEN BEGIN NHOUTDMP(DEV,FILE,BUF,FLAG); FLAG←0; RETURN END;
IF PAGED(BUF) AND TFILE(BUF) THEN CHAN←IOCHAN(BUF)
ELSE CHAN←OPENFILE(FILE,"WC");
OUSCBUF←USC(BUF);
USC(BUF)←128;
IF PAGED(BUF) THEN BEGIN
IF DIRTY[BUF] THEN FOR I←1 THRU USETAB[BUF] DO
IF (DUM←MEMORY[ITRT(BUF)+I-1])≠0 THEN ROWOUT(DUM,BUF);
DIRTY[BUF]←0;
END
ELSE BEGIN
SWDPTR(CHAN,128);
ARRYOUT(CHAN,MEMORY[PICTAB[BUF]],ITFSIZ(BUF));
END;
ARRBLT(TARR[0],MEMORY[HEDTAB[BUF]],128);
CASE FLAG OF BEGIN
;;
BEGIN TARR[1] SWAP TARR[2];
TARR[5]←1;
TARR[0]←TARR[11];
TARR[3]←TARR[2];
FOR I←6 STEP 1 UNTIL 30 DO TARR[I]←0 END;
BEGIN TARR[0]←-1; TARR[7]←((-TARR[4]) LSH 18) LOR 128;
TARR[6]←(TARR[5] LAND '777777)+TARR[2]-1;
TARR[2]←TARR[3];
TARR[3]←TARR[5] LSH -18;
TARR[5]←TARR[5] LAND '777777;
TARR[4]←TARR[3]+TARR[11]-1;
FOR I←8 STEP 1 UNTIL 30 DO TARR[I]←0 END;
END;
SWDPTR(CHAN,0);
ARRYOUT(CHAN,TARR[0],128);
FLAG←0;
IF PAGED(BUF) THEN IF TFILE(BUF) THEN BEGIN
do begin
RENAME(CHAN,FILE,'155,DUM←0);
if dum then begin print("Illegal name ",file,crlf,"New name: ");
file←intty end;
end until dum=0;
TFILE(BUF)←0
END
ELSE BEGIN
INTEGER OC;
OC←IOCHAN(BUF);
SWDPTR(OC,OUSCBUF);
INOUT(OC,CHAN,ITFSIZ(BUF));
USC(BUF)←OUSCBUF;
CFILE(CHAN)
END
ELSE CFILE(CHAN);
END;
SIMPLE INTERNAL PROCEDURE FREBUF(INTEGER BUF);
BEGIN
IF USETAB[BUF] =0 THEN RETURN;
IF PAGED(BUF) THEN BEGIN
IF TFILE(BUF) THEN BEGIN
CLOSF(IOCHAN(BUF));
DELNF(IOCHAN(BUF),0)
END;
CFILE(IOCHAN(BUF))
END;
USETAB[BUF]←0;
IF PICTAB[BUF]=0 THEN RETURN;
RELCORE(COLTAB[BUF]);
RELCORE(ROWTAB[BUF]);
RELCORE(PICTAB[BUF]);
RELCORE(HEDTAB[BUF]);
PICTAB[BUF]←0;
if newssw then print("Deallocated buffer",crlf);
END;
SIMPLE INTERNAL PROCEDURE ROWIN(INTEGER I,BUF);
BEGIN "ROWIN"
INTEGER II,ROWCLOC,I1,PTR,WPR,OI;
PTR←ITRT(BUF);
OI←MEMORY[PTR+(II←USETAB[BUF]-1)];
IF OI<0
THEN ROWCLOC←-OI
ELSE BEGIN
ROWCLOC←ROWP(OI);
IF DIRTY[BUF] THEN ROWOUT(OI,BUF);
ROWP(OI)←0;
END;
FOR I1←II DOWNTO 1 DO
MEMORY[PTR+I1]←MEMORY[PTR+I1-1];
MEMORY[PTR]←I;
ROWP(I)←ROWCLOC;
SWDPTR(II←(IOCHAN(BUF)),USC(BUF)+(WPR←ITRSIZ(BUF))*(I-1));
ARRYIN(II,MEMORY[ROWCLOC],WPR);
PAGFLT[BUF]←PAGFLT[BUF]+1;
IF !SKIP! THEN BEGIN "NOEX"
SWDPTR(II,USC(BUF)+WPR*(I-1));
SMEAR(ROWCLOC,WPR,0);
ARRYIN(II,MEMORY[ROWCLOC],WPR) END;
END;
DEFINE SORT(I,BUF)="BEGIN
INTEGER PTR,II,TMP;
PTR←ITRT(BUF);
FOR II←0 THRU USETAB[BUF]-1 DO
IF MEMORY[PTR+II]=I THEN DONE;
TMP←MEMORY[PTR+II];
FOR II←II DOWNTO 1 DO
MEMORY[PTR+II]←MEMORY[PTR+II-1];
MEMORY[PTR]←TMP;
END";
DEFINE INPPAG="IF PAGED(BUF) THEN
IF NOT(ROWP(I)) THEN ROWIN(I,BUF) ELSE SORT(I,BUF);";
DEFINE OUPPAG="IF PAGED(BUF) THEN BEGIN
IF NOT(TFILE(BUF)) THEN BEGIN
INTEGER IC,OC;
IC←IOCHAN(BUF);
IOCHAN(BUF)←OC←OPENFILE(NEWNAM(BUF),""WRC"");
SWDPTR(IC,USC(BUF));
USC(BUF)←128;
ARRYOUT(OC,MEMORY[HEDTAB[BUF]],128);
INOUT(IC,OC,ITFSIZ(BUF));
CFILE(IC);
TFILE(BUF)←-1;
END;
IF NOT(ROWP(I)) THEN ROWIN(I,BUF)
ELSE SORT(I,BUF);
DIRTY[BUF]←-1;
END;";
SIMPLE INTERNAL INTEGER PROCEDURE INPTR(INTEGER I,J,BUF);
BEGIN
INPPAG;
RETURN(ROWP(I)+COLP(J));
END;
SIMPLE INTERNAL INTEGER PROCEDURE OUTPTR(INTEGER I,J,BUF);
BEGIN
OUPPAG;
RETURN(ROWP(I)+COLP(J));
END;
REDEFINE SORT(I,BUF)="";
SIMPLE INTERNAL INTEGER PROCEDURE GETPNT(INTEGER I,J,BUF);
BEGIN
INPPAG;
RETURN(ILDB(DUM←ROWP(I)+COLP(J)));
END;
SIMPLE INTERNAL PROCEDURE PUTPNT(INTEGER I,J,VAL,BUF);
BEGIN
OUPPAG;
IDPB(VAL,DUM←ROWP(I)+COLP(J));
END;
INTERNAL PROCEDURE GETBUF(INTEGER I,J,BYT,BUF);
BEGIN
INTEGER SME;
IF INITBUF=0 THEN IINNIITT;
IF BYT<0 THEN BEGIN BYT←-BYT; SME←-1 END ELSE SME←0;
HEDTAB[BUF]←GETZCORE(128);
MEMORY[HEDTAB[BUF]]←128;
MEMORY[HEDTAB[BUF]+1]←BYT;
MEMORY[HEDTAB[BUF]+2]←J;
MEMORY[HEDTAB[BUF]+3]←((J-1)%(36%BYT))+1;
MEMORY[HEDTAB[BUF]+4]←MEMORY[HEDTAB[BUF]+3]*I;
MEMORY[HEDTAB[BUF]+5]←(1 LSH 18) LOR 1;
FOR DUM←6 STEP 1 UNTIL 10 DO MEMORY[HEDTAB[BUF]+DUM]←0;
MEMORY[HEDTAB[BUF]+ROWLOC]←I;
PICTAB[BUF]←ALLOCPIC(BUF);
IF PAGED(BUF)
THEN BEGIN
IOCHAN(BUF)←OPENFILE(NEWNAM(BUF),"RWC");
TFILE(BUF)←-1;
SWDPTR(IOCHAN(BUF),128);
BEGIN
SAFE INTEGER ARRAY BUFR[0:127];
INTEGER I,NUM,OC;
OC←IOCHAN(BUF);
NUM←ITFSIZ(BUF);
ARRCLR(BUFR,SME);
FOR I←128 STEP 128 UNTIL NUM DO
ARRYOUT(OC,BUFR[0],128);
I←NUM-(I-128);
IF I>0 THEN ARRYOUT(OC,BUFR[0],I);
END;
END
ELSE SMEAR(PICTAB[BUF],ITFSIZ(BUF),SME);
RCTABS(BUF);
END;
SIMPLE INTERNAL PROCEDURE GETHDR(SAFE INTEGER ARRAY HDRARR; INTEGER BUF);
BEGIN "GETHDR"
INTEGER I;
! FOR I←0 STEP 1 UNTIL 127 DO HDRARR[I]←MEMORY[HEDTAB[BUF]+I];
ARRBLT(HDRARR[0],MEMORY[HEDTAB[BUF]],128);
END;
SIMPLE INTERNAL PROCEDURE PUTHDR(SAFE INTEGER ARRAY HDRARR; INTEGER BUF);
BEGIN "PUTHDR"
INTEGER I;
FOR I←0 STEP 1 UNTIL MAXUSE DO IF HDRARR[I]≠MEMORY[HEDTAB[BUF]+I]
THEN PRINT("UGH. CHANGING HEADER ENTRY ",I," YOU CAN'T DO THAT! ",
"FOR ENTRIES LESS THAN ",MAXUSE,CRLF);
FOR I←MAXUSE+1 STEP 1 UNTIL 127 DO MEMORY[HEDTAB[BUF]+I]←HDRARR[I];
END;
SIMPLE INTERNAL PROCEDURE COPHDR(INTEGER INHBUF,OUTHBUF);
ARRBLT(MEMORY[HEDTAB[OUTHBUF]+MAXUSE],MEMORY[HEDTAB[INHBUF]+MAXUSE],128-MAXUSE);
SIMPLE INTERNAL PROCEDURE BUFINIT;
BEGIN
IF INITBUF THEN BEGIN PRINT("You alread initialized it.",crlf);
return; end;
ARRCLR(ROWTAB);
ARRCLR(PICTAB);
ARRCLR(COLTAB);
ARRCLR(USETAB);
ARRCLR(HEDTAB);
NUMPAG←10;
NEWSSW←0;
initbuf←-1;
END;
SIMPLE INTERNAL PROCEDURE FORINIT;
BEGIN INITBUF←0; BUFINIT END;
SIMPLE INTERNAL PROCEDURE NEWS(INTEGER VAR);
NEWSSW←VAR;
SIMPLE INTERNAL PROCEDURE PAGSET(INTEGER PAGNO);
NUMPAG←PAGNO;
EXTERNAL PROCEDURE CROPPL(INTEGER BUFF,OBUF,SI,EI,SJ,EJ,PI,PJ);
SIMPLE INTERNAL PROCEDURE COPY(INTEGER INBUF, OUTBUF);
BEGIN
CROPPL(INBUF,OUTBUF,1,ROWS(INBUF),1,COLMS(INBUF),1,1);
END;
END